home *** CD-ROM | disk | FTP | other *** search
/ Apple II Magazines (DO) / A+ Disk Magazine Volume 1, No. 1 (1984)(Ziff-Davis).zip / A+ Disk Magazine Volume 1, No. 1 (1984)(Ziff-Davis).do / PERPCAL.bas < prev    next >
BASIC Source File  |  1996-12-24  |  10KB  |  230 lines
  1. 1  HOME : VTAB 8: HTAB 12: PRINT "A+ DISK MAGAZINE"
  2. 2  VTAB 10: HTAB 16: PRINT "PRESENTS"
  3. 3  VTAB 12: HTAB 11: INVERSE : PRINT "PERPETUAL CALENDAR": NORMAL 
  4. 4  FOR I = 1 TO 800: NEXT I
  5. 5  VTAB 15: HTAB 12: PRINT "BY MORRIS EFFRON"
  6. 6  PRINT "<CTRL-G><CTRL-G><CTRL-G><CTRL-G><CTRL-G>"
  7. 7  VTAB 18: HTAB 14: PRINT "PROGRAMMED BY"
  8. 8  VTAB 20: HTAB 10: PRINT "OPPENHEIMER SOFTWARE"
  9. 9  VTAB 23: HTAB 22: PRINT "(C)COPYRIGHT 1983": FOR I = 1 TO 3500: NEXT I
  10. 10  REM  ** THE PERPETUAL CALENDAR
  11. 50 B$ = " ": FOR I = 1 TO 100:B$ = B$ +" ": NEXT I
  12. 60 AS$ = "*": FOR I = 1 TO 100:AS$ = AS$ +"*": NEXT 
  13. 100  GOSUB 430
  14. 105  HOME 
  15. 107  INVERSE 
  16. 110  VTAB 1: HTAB 18: PRINT "THE"
  17. 140  VTAB 3: HTAB 11: PRINT "PERPETUAL"
  18. 170  VTAB 3: HTAB 21: PRINT "CALENDAR"
  19. 220  VTAB 1: HTAB 18: PRINT "THE"
  20. 240  VTAB 3: HTAB 11: PRINT "PERPETUAL CALENDAR"
  21. 260  NORMAL 
  22. 270  VTAB 7: HTAB 1: PRINT "1. NUMBER OF DAYS BETWEEN TWO DATES."
  23. 280  VTAB 9: HTAB 1: PRINT "2. WEEKDAY OF ANY DATE."
  24. 290  VTAB 11: HTAB 1: PRINT "3. CALENDAR FOR ANY MONTH."
  25. 340  VTAB 13: HTAB 1: PRINT "4. EXIT."
  26. 350  VTAB 15: HTAB 7: PRINT "PLEASE ENTER CHOICE:   "
  27. 390  VTAB 17: HTAB 6: PRINT  LEFT$(B$,40): VTAB 15: HTAB 28: PRINT "  ": VTAB 15: HTAB 28
  28. 400 A$ = "": GET A$: IF A$ = ""  THEN  GOTO 400
  29. 410  VTAB 15: HTAB 28: PRINT A$
  30. 415  IF A$ < >"1"  AND A$ < >"2"  AND A$ < >"3"  AND A$ < >"4"  THEN  VTAB 17: HTAB 7: PRINT "1, 2, 3 OR 4 PLEASE": FOR I = 1 TO 1000: NEXT I: GOTO 390
  31. 420  ON  VAL(A$) GOSUB 940,1490,1910,2830
  32. 425  GOTO 350
  33. 430  REM  **INITIALIZATION
  34. 440  DIM DS$(7),MS$(12),DS(12),NL(7)
  35. 445  DIM CL$(5,7)
  36. 450  DATA  "SUNDAY"
  37. 460  DATA  "MONDAY"
  38. 470  DATA  "TUESDAY"
  39. 480  DATA  "WEDNESDAY"
  40. 490  DATA  "THURSDAY"
  41. 500  DATA  "FRIDAY"
  42. 510  DATA  "SATURDAY"
  43. 520  DATA   "JANUARY" ,31
  44. 540  DATA  "FEBRUARY",28
  45. 550  DATA  "MARCH",31
  46. 580  DATA  "APRIL",30
  47. 590  DATA  "MAY",31
  48. 600  DATA  "JUNE",30
  49. 610  DATA  "JULY",31
  50. 620  DATA  "AUGUST",31
  51. 630  DATA  "SEPTEMBER",30
  52. 640  DATA  "OCTOBER",31
  53. 660  DATA  "NOVEMBER",30
  54. 690  DATA  "DECEMBER",31
  55. 750  DATA  1900,2100,2200,2300,2500,2600,2700
  56. 830  FOR I = 1 TO 7: READ DS$(I): NEXT I
  57. 860  FOR I = 1 TO 12: READ MS$(I),DS(I): NEXT 
  58. 900  FOR I = 1 TO 7: READ NL(I): NEXT I
  59. 920  RETURN 
  60. 940  REM  ** DAYS BETWEEN TWO DATES **
  61. 950  VTAB 17: HTAB 3:AD$ = ""
  62. 970  INPUT "FIRST DATE (MM/DD/YYYY): ";AD$
  63. 980  IF AD$ = ""  THEN  VTAB 17: HTAB 1: PRINT  LEFT$(B$,30): RETURN 
  64. 990  GOSUB 3050: IF OK  THEN 1090
  65. 1000  VTAB 19: HTAB 5: PRINT "BAD DATE. PLEASE RE-ENTER."
  66. 1020  FOR I = 1 TO 1000: NEXT I: VTAB 19: HTAB 5: PRINT  LEFT$(B$,30)
  67. 1030  VTAB 17: HTAB 1: PRINT  LEFT$(B$,40): GOTO 950
  68. 1090 Y1 = Y:M1 = M:D1 = D
  69. 1100  VTAB 19: HTAB 2:AD$ = ""
  70. 1120  INPUT "SECOND DATE (MM/DD/YYYY): ";AD$
  71. 1130  GOSUB 3050: IF OK  THEN 1260
  72. 1170  VTAB 21: HTAB 5: PRINT "BAD DATE. PLEASE RE-ENTER."
  73. 1180  FOR I = 1 TO 1000: NEXT I: VTAB 21: HTAB 5: PRINT  LEFT$(B$,40)
  74. 1190  VTAB 19: HTAB 1: PRINT  LEFT$(B$,40): GOTO 1100
  75. 1260 Y2 = Y:M2 = M:D2 = D
  76. 1290  GOSUB 3190
  77. 1300  VTAB 21: HTAB 10: PRINT "THE NUMBER OF DAYS"
  78. 1305  VTAB 22: HTAB 7: PRINT "BETWEEN THESE DATES IS: ";
  79. 1350  PRINT TDS
  80. 1370  VTAB 23: HTAB 5: PRINT "(PRESS ANY KEY TO CONTINUE)";
  81. 1380 A$ = "": GET A$: IF A$ = ""  THEN 1380
  82. 1390  VTAB 17: HTAB 1: PRINT  LEFT$(B$,40): VTAB 19: HTAB 1: PRINT  LEFT$(B$,40)
  83. 1392  VTAB 21: HTAB 1: PRINT  LEFT$(B$,40)
  84. 1395  VTAB 22: HTAB 1: PRINT  LEFT$(B$,40): VTAB 23: HTAB 1: PRINT  LEFT$(B$,39): GOTO 950
  85. 1490  REM  ** WEEKDAY DETERMINATION ROUTINE
  86. 1500 Y1 = 1983:M1 = 1:D1 = 1
  87. 1530  VTAB 17: HTAB 3:AD$ = ""
  88. 1550  INPUT "DATE (MM/DD/YYYY): ";AD$
  89. 1560  IF AD$ = ""  THEN  VTAB 17: HTAB 3: PRINT  LEFT$(B$,40): RETURN 
  90. 1570  GOSUB 3050: IF OK  THEN 1670
  91. 1580  VTAB 19: HTAB 3: PRINT "BAD DATE. PLEASE RE-ENTER."
  92. 1590  FOR I = 1 TO 1000: NEXT I
  93. 1620  VTAB 19: HTAB 3: PRINT  LEFT$(B$,40): VTAB 17: HTAB 3: PRINT  LEFT$(B$,30): GOTO 1530
  94. 1670 Y2 = Y:M2 = M:D2 = D
  95. 1700  GOSUB 3190
  96. 1710  IF TD >32767  THEN TD = TD -32767: GOTO 1710
  97. 1740 WD =  INT((TD/7 - INT(TD/7)) *7 +.05) * SGN(TD/7)
  98. 1750  IF PR = 0  THEN WD$ = DS$(7 -WD): GOTO 1755
  99. 1751  IF WD >0  THEN WD$ = DS$(WD): GOTO 1755
  100. 1752 WD$ = DS$(7)
  101. 1755  VTAB 20: HTAB 5: PRINT "THIS DAY IS A ";
  102. 1760  INVERSE : PRINT WD$: NORMAL 
  103. 1770  VTAB 22: HTAB 3: PRINT "(PRESS ANY KEY TO CONTINUE)";
  104. 1800 A$ = "": GET A$: IF A$ = "" GOTO 1800
  105. 1810  VTAB 17: HTAB 1: PRINT  LEFT$(B$,40): VTAB 19: HTAB 1: PRINT  LEFT$(B$,40)
  106. 1815  VTAB 22: HTAB 1: PRINT  LEFT$(B$,40): VTAB 20: HTAB 1: PRINT  LEFT$(B$,40)
  107. 1850  GOTO 1530
  108. 1910  REM   ** CALENDAR PRINT ROUTINE **
  109. 1930 Y1 = 1983:M1 = 1:D1 = 1
  110. 1931  VTAB 18: HTAB 5: PRINT "DO YOU HAVE A PRINTER (Y/N)? ";: GET T$
  111. 1932  VTAB 18: HTAB 34: PRINT T$
  112. 1933  IF T$ = "Y"  THEN 1938
  113. 1934  VTAB 20: HTAB 5: PRINT "NO PRINTER AVAILABLE"
  114. 1935  FOR I = 1 TO 1000: NEXT I
  115. 1936  FOR I = 17 TO 22: VTAB  INT(I): PRINT  LEFT$(B$,40): NEXT I
  116. 1937  GOTO 350
  117. 1938  VTAB 19: INPUT "ENTER SLOT NUMBER FOR YOUR PRINTER: ";N$
  118. 1939  IF N$ = ""  OR N$ = "0"  THEN N$ = "1"
  119. 1940 N% =  VAL(N$)
  120. 1980  VTAB 21: HTAB 5
  121. 1990  INPUT "DATE (MM/YYYY):  ";AD$
  122. 2000  IF AD$ = ""  THEN  VTAB 18: HTAB 1: PRINT B$: PRINT  LEFT$(B$,40): RETURN 
  123. 2020 AD$ = "0" +AD$:AD$ =  RIGHT$(AD$,7)
  124. 2030 AD$ =  LEFT$(AD$,3) +"01/" + RIGHT$(AD$,4)
  125. 2040  GOSUB 3050: IF OK  THEN 2140
  126. 2050  VTAB 22: HTAB 1: PRINT "BAD DATE. PLEASE RE-ENTER."
  127. 2060  FOR I = 1 TO 1000: NEXT I
  128. 2070  HTAB 1: VTAB 21: PRINT  LEFT$(B$,40): HTAB 1: VTAB 22: PRINT  LEFT$(B$,40): GOTO 1980
  129. 2140 Y2 = Y:M2 = M:D2 = D
  130. 2150  GOSUB 3190
  131. 2180  IF TD >32767  THEN TD = TD -32767: GOTO 2180
  132. 2190 WD =  INT((TD/7 - INT(TD/7)) *7 +.05) * SGN(TD/7)
  133. 2200  IF PR = 0  THEN WD = 7 -WD: GOTO 2250
  134. 2210  IF WD = 0  THEN WD = 7
  135. 2230  VTAB 23: HTAB 5: PRINT "PRESS ANY KEY TO PRINT ";
  136. 2250 A$ = "": GET A$: IF A$ = ""  THEN 2250
  137. 2251  VTAB 23: PRINT  LEFT$(B$,40);
  138. 2260  PR# N%: PRINT  CHR$(9); CHR$(1); CHR$(1);"80N";
  139. 2270 MX = DS(M2): IF LL  AND M2 = 2  THEN MX = 29
  140. 2280 DM = 0
  141. 2290  FOR I = 1 TO 5
  142. 2300  FOR J = 1 TO 7
  143. 2310  IF ((I -1) *7) +J <WD  OR DM +1 >MX  THEN CL$(I,J) = "*" + LEFT$(B$,10): GOTO 2325
  144. 2320 DM = DM +1:DM$ =  STR$(DM):CL$(I,J) = "* " +DM$ + LEFT$(B$,(9 - LEN(DM$)))
  145. 2325  NEXT J
  146. 2330  NEXT I
  147. 2340 ST = 0
  148. 2345  IF DM = MX  THEN 2380
  149. 2350  FOR I = DM +1 TO MX
  150. 2360 ST = ST +1:CL$(5,ST) =  LEFT$(CL$(5,ST),4) +"/" + STR$(I) + LEFT$(B$,4)
  151. 2370  NEXT I
  152. 2380 LN =  LEN(MS$(M2)) + LEN( STR$(Y2)) +1
  153. 2390 LN =  INT((80 -LN)/2): PRINT  CHR$(12): PRINT  LEFT$(B$,LN);MS$(M2);" "; STR$(Y2)
  154. 2405  PRINT 
  155. 2440  PRINT " "; LEFT$(AS$,78)
  156. 2490  GOSUB 3480: PRINT " ";
  157. 2500  FOR I = 1 TO 7:LD =  LEN(DS$(I))
  158. 2505 S1 = 10 -LD:S2 =  INT(S1/2):S3 = S1 -S2
  159. 2510  PRINT "*";: IF S2 < >0  THEN  PRINT  LEFT$(B$,S2);
  160. 2520  PRINT DS$(I);: IF S3 < >0  THEN  PRINT  LEFT$(B$,S3);
  161. 2530  NEXT I
  162. 2540  PRINT "*": GOSUB 3480
  163. 2560  GOSUB 3540
  164. 2570  FOR I = 1 TO 5
  165. 2580  PRINT " ";
  166. 2590  FOR J = 1 TO 7: PRINT CL$(I,J);
  167. 2600  NEXT J: PRINT "*"
  168. 2630  FOR J = 1 TO 5: GOSUB 3480: NEXT J
  169. 2660  IF I <5  THEN  GOSUB 3540: NEXT I
  170. 2670  PRINT " "; LEFT$(AS$,78)
  171. 2715  PRINT  CHR$(12): PR# 0
  172. 2720  VTAB 23: HTAB 5: PRINT "(PRESS ANY KEY TO CONTINUE)";
  173. 2730 A$ = "": GET A$: IF A$ = ""  THEN 2730
  174. 2740  VTAB 21: HTAB 1: PRINT  LEFT$(B$,40): VTAB 23: HTAB 1: PRINT  LEFT$(B$,39)
  175. 2750  VTAB 20: HTAB 1: PRINT  LEFT$(B$,40)
  176. 2800  GOTO 1980
  177. 2830  HOME 
  178. 2835  END 
  179. 3050  REM  ** DATE VALIDATION
  180. 3060 OK = 0
  181. 3070 AL =  LEN(AD$): IF AL = 10  THEN 3090
  182. 3075  IF  MID$ (AD$,2,1) = "/"  THEN AD$ = "0" +AD$:AL = AL +1: IF AL = 10  THEN 3090
  183. 3080  IF  MID$ (AD$,5,1) = "/"  THEN AD$ =  LEFT$(AD$,3) +"0" + RIGHT$(AD$,6)
  184. 3090  IF  MID$ (AD$,3,1) < >"/"  THEN  RETURN 
  185. 3092  IF  MID$ (AD$,6,1) < >"/"  THEN  RETURN 
  186. 3120 Y =  VAL( RIGHT$(AD$,4)): IF Y <1800  OR Y >2800  THEN  RETURN 
  187. 3130 LP = 0: IF Y/100 < > INT(Y/100)  THEN  IF Y/4 =  INT(Y/4)  THEN LP =  -1
  188. 3140  IF Y = 2000  OR Y = 2400  OR Y = 2800  THEN LP =  -1
  189. 3145 M =  VAL( LEFT$(AD$,2)): IF M <1  OR M >12  THEN  RETURN 
  190. 3150 MX = DS(M): IF M = 2  AND LP  THEN MX = 29
  191. 3160 D =  VAL( MID$ (AD$,4,2)): IF D <1  OR D >MX  THEN  RETURN 
  192. 3170 OK =  -1: RETURN 
  193. 3190  REM  ** COMPUTES DAYS BETWEEN DATES
  194. 3210 PR = 0:TD = 0
  195. 3220  IF Y1 <Y2  THEN PR =  -1
  196. 3240  IF Y1 = Y2  AND M1 <M2  THEN PR =  -1
  197. 3250  IF Y1 = Y2  AND M1 = M2  AND D1 <D2  THEN PR =  -1
  198. 3260 L1 = 0: IF Y1/100 < > INT(Y1/100)  THEN  IF Y1/4 =  INT(Y1/4)  THEN L1 =  -1
  199. 3265  IF Y1 = 2000  OR Y1 = 2400  OR Y1 = 2800  THEN L1 =  -1
  200. 3270 L2 = 0: IF Y2/100 < > INT(Y2/100)  THEN  IF Y2/4 =  INT(Y2/4)  THEN L2 =  -1
  201. 3275  IF Y2 = 2000  OR Y2 = 2400  OR Y2 = 2800  THEN L2 =  -1
  202. 3280 FY = Y1:FM = M1:FD = D1:FL = L1:LY = Y2:LM = M2:LD = D2:LL = L2
  203. 3282  IF PR = 0  THEN FY = Y2:FM = M2:FD = D2:FL = L2:LY = Y1:LM = M1:LD = D1:LL = L1
  204. 3290 NY = LY -FY: IF NY >0  THEN TD =  INT(NY *365.25) -365
  205. 3310  FOR I = 1 TO 7
  206. 3320  IF NL(I) >FY  AND NL(I) <LY  THEN TD = TD -1
  207. 3330  NEXT I
  208. 3335  IF LM -1 = 0  THEN 3345
  209. 3340  FOR I = 1 TO LM -1:TD = TD +DS(I): NEXT I
  210. 3345  IF NY < >2  AND NY < >3  THEN 3370
  211. 3347  FOR I = FY +1 TO LY -1: IF I/100 < > INT(I/100)  THEN  IF I/4 =  INT(I/4)  THEN TD = TD +1
  212. 3350  IF I = 2000  OR I = 2400  OR I = 2800  THEN TD = TD +1
  213. 3355  NEXT I
  214. 3370  IF LL  AND LM >2  THEN TD = TD +1
  215. 3380 TD = TD +LD
  216. 3389  IF FM = 12  THEN 3420
  217. 3390  FOR I = FM +1 TO 12:TD = TD +DS(I): NEXT I
  218. 3420 TD = TD +DS(FM) -FD
  219. 3430  IF FL  AND FM <3  THEN TD = TD +1
  220. 3440  IF FY < >LY  THEN  RETURN 
  221. 3445  IF LL  THEN TD = TD -366: RETURN 
  222. 3450 TD = TD -365: RETURN 
  223. 3470  REM  ** CALENDAR  PRINT ROUTINES **
  224. 3480  PRINT " ";
  225. 3490  FOR K = 1 TO 7: PRINT "*" + LEFT$(B$,10);: NEXT K
  226. 3520  PRINT "*"
  227. 3530  RETURN 
  228. 3540  PRINT " "; LEFT$(AS$,78): RETURN 
  229. 3550  FOR K = 1 TO 7: PRINT  LEFT$(AS$,11);: NEXT K
  230. 3560  RETURN